home *** CD-ROM | disk | FTP | other *** search
/ Deutsche Edition 1 / Deutsche Edition 1.iso / amok / 041-050 / amok42 / ineyes / ineyes.mod < prev    next >
Text File  |  1993-11-04  |  7KB  |  305 lines
  1. MODULE InEyes;
  2.  
  3. (************************************************************************)
  4. (*                                    *)
  5. (* (c) Ingo Schütze, 1990                        *)
  6. (*     Version 1.0                            *)
  7. (*                                    *)
  8. (************************************************************************)
  9. (*                                    *)
  10. (* Ein Screen-Hack.                            *)
  11. (*                                    *)
  12. (************************************************************************)
  13.  
  14. FROM Intuition IMPORT
  15.     NewWindow, OpenWindow, WindowPtr, CloseWindow, IDCMPFlagSet,
  16.     IDCMPFlags, WindowFlagSet, WindowFlags, wbenchScreen,
  17.     ScreenFlagSet, IntuiMessage, ScreenPtr;
  18.  
  19. FROM Arts IMPORT
  20.     TermProcedure, Assert;
  21.  
  22. FROM SYSTEM IMPORT
  23.     ADR, LONGSET, INLINE, ADDRESS;
  24.  
  25. FROM Exec IMPORT
  26.     GetMsg, ReplyMsg, WaitPort, SetSignal, AllocMem, MemReqSet, MemReqs,
  27.     FreeMem, FindTask, SetTaskPri;
  28.  
  29. FROM Graphics IMPORT
  30.     RastPortPtr, SetDrMd, jam1, SetAPen, SetRGB4, ViewPortPtr, GetRGB4,
  31.     LoadRGB4,
  32.     SimpleSprite, GetSprite, MoveSprite, FreeSprite,
  33.     AreaEllipse, TmpRas, AreaInfo, InitArea, InitTmpRas, AreaEnd,
  34.     AllocRaster, FreeRaster;
  35.  
  36. FROM GfxMacros IMPORT
  37.     RasSize, SetAfPen;
  38.  
  39.  
  40.  
  41. TYPE
  42.   CardPtr    = POINTER TO CARDINAL;
  43.  
  44. CONST
  45.   xml        = 25;        (* x-Mittelpunkt linkes Auge    *)
  46.   yml        = 35;        (* y-                *)
  47.   xmr        = 75;        (* x-MP rechtes Auge        *)
  48.   ymr        = 35;        (* y                *)
  49.   SpriteSize    = 40;
  50.  
  51. VAR
  52.   InWindow    : WindowPtr;
  53.   InWinDat    : NewWindow;
  54.   Message    : POINTER TO IntuiMessage;
  55.   class        : IDCMPFlagSet;
  56.   InRastPort    : RastPortPtr;
  57.   WBScreen    : ScreenPtr;
  58.   VPort        : ViewPortPtr;
  59.  
  60.   InSprite1, InSprite2         : SimpleSprite;
  61.   ChipSprite1, ChipSprite2    : CardPtr;
  62.   s1, s2            : INTEGER;
  63.  
  64.   xmlk,  ymlk,  xmrk,  ymrk    : INTEGER;
  65.   mx, my            : INTEGER;
  66.  
  67.   IP                : INTEGER;
  68.  
  69.   oldColors            : ARRAY[0..19] OF CARDINAL;
  70.  
  71. PROCEDURE CleanUp;
  72. BEGIN
  73.   IF InWindow#NIL THEN
  74.     CloseWindow(InWindow);
  75.     InWindow:=NIL;
  76.   END;
  77.   IF (s1=1) OR (s2=1) THEN
  78.     LoadRGB4(VPort,ADR(oldColors),20);
  79.   END;
  80.   IF s1#-1 THEN
  81.     FreeMem(ChipSprite1, SpriteSize);
  82.     FreeSprite(s1);
  83.   END;
  84.   IF s2#-1 THEN
  85.     FreeMem(ChipSprite2, SpriteSize);
  86.     FreeSprite(s2);
  87.   END;
  88.  
  89. END CleanUp;
  90.  
  91. PROCEDURE ChipCopy(source : CardPtr; VAR dest : CardPtr; size : LONGCARD);
  92. VAR
  93.   ChipPtr : CardPtr;
  94.   copied : LONGCARD;
  95. BEGIN
  96.   ChipPtr:=AllocMem(size, MemReqSet{chip});
  97.   dest:=ChipPtr;
  98.   copied:=0;
  99.   REPEAT
  100.     ChipPtr^ := source^ ;
  101.     INC(ChipPtr,2); INC(source,2); INC(copied,2);
  102.   UNTIL copied=size;
  103. END ChipCopy;
  104.  
  105.  
  106. PROCEDURE Koo;
  107. VAR le, te : INTEGER;
  108. BEGIN
  109.   le:=InWindow^.leftEdge;
  110.   te:=InWindow^.topEdge;
  111.   mx:=WBScreen^.mouseX;
  112.   my:=WBScreen^.mouseY;
  113.  
  114.   xmlk:=le + xml - 25 + 10*(mx-le+xml) DIV 600;
  115.   ymlk:=te + yml -  6 + 10*(my-te+yml) DIV 200;
  116.   xmrk:=le + xmr - 25 + 10*(mx-le+xmr) DIV 600;
  117.   ymrk:=te + ymr -  6 + 10*(my-te+ymr) DIV 200;
  118. END Koo;
  119.  
  120.  
  121. PROCEDURE SpriteDaten; (* $E- *)
  122. BEGIN
  123.   INLINE(00000H,00000H);
  124.   INLINE(0003CH,00000H);
  125.   INLINE(0007EH,00000H);
  126.   INLINE(000E7H,00018H);
  127.   INLINE(000DBH,0003CH);
  128.   INLINE(000DBH,0003CH);
  129.   INLINE(000E7H,00018H);
  130.   INLINE(0007EH,00000H);
  131.   INLINE(0003CH,00000H);
  132.   INLINE(00000H,00000H);
  133. END SpriteDaten;
  134.  
  135.  
  136. PROCEDURE InstallSprites;
  137. VAR i : INTEGER;
  138.     s3 : INTEGER;
  139. BEGIN
  140.   Koo;s3:=10;
  141.   ChipSprite1:=NIL;
  142.   ChipCopy(ADR(SpriteDaten),ChipSprite1,SpriteSize);
  143.   WITH InSprite1 DO
  144.     posctldata:=ChipSprite1;
  145.     height:=8;
  146.     x:=xmlk;
  147.     y:=ymlk;
  148.     num:=6;
  149.   END;
  150.   s1:=GetSprite(ADR(InSprite1),-1);
  151.   IF s1<2 THEN
  152.     s3:=s1;
  153.     s1:=GetSprite(ADR(InSprite1),-1);
  154.   END;
  155.   CASE s1 OF
  156.     | 2,3 :
  157.     SetRGB4(VPort,20,0,0,0);
  158.     SetRGB4(VPort,21,0,0,15);
  159.     SetRGB4(VPort,22,0,0,0);
  160.     SetRGB4(VPort,23,0,0,0);
  161.     | 4,5 :
  162.     SetRGB4(VPort,24,0,0,0);
  163.     SetRGB4(VPort,25,0,0,15);
  164.     SetRGB4(VPort,26,0,0,0);
  165.     SetRGB4(VPort,27,0,0,0);
  166.     | 6,7 :
  167.     SetRGB4(VPort,28,0,0,0);
  168.     SetRGB4(VPort,29,0,0,15);
  169.     SetRGB4(VPort,30,0,0,0);
  170.     SetRGB4(VPort,31,0,0,0);
  171.   ELSE
  172.   END;
  173.  
  174.   ChipSprite2:=NIL;
  175.   ChipCopy(ADR(SpriteDaten),ChipSprite2,SpriteSize);
  176.   WITH InSprite2 DO
  177.     posctldata:=ChipSprite2;
  178.     height:=8;
  179.     x:=xmrk;
  180.     y:=ymrk;
  181.     num:=7;
  182.   END;
  183.   s2:=GetSprite(ADR(InSprite2),-1);
  184.   CASE s2 OF
  185.     | 2,3 :
  186.     SetRGB4(VPort,20,0,0,0);
  187.     SetRGB4(VPort,21,0,0,15);
  188.     SetRGB4(VPort,22,0,0,0);
  189.     SetRGB4(VPort,23,0,0,0);
  190.     | 4,5 :
  191.     SetRGB4(VPort,24,0,0,0);
  192.     SetRGB4(VPort,25,0,0,15);
  193.     SetRGB4(VPort,26,0,0,0);
  194.     SetRGB4(VPort,27,0,0,0);
  195.     | 6,7 :
  196.     SetRGB4(VPort,28,0,0,0);
  197.     SetRGB4(VPort,29,0,0,15);
  198.     SetRGB4(VPort,30,0,0,0);
  199.     SetRGB4(VPort,31,0,0,0);
  200.   ELSE
  201.   END;
  202.  
  203.   IF s3<2 THEN
  204.     FreeSprite(s3);
  205.   END;
  206.  
  207.   Assert((s1#-1)OR(s2#-1),ADR("Kann kein Sprite mehr darstellen!"));
  208.  
  209. END InstallSprites;
  210.  
  211.  
  212. PROCEDURE OpWin;
  213. BEGIN
  214.   WITH InWinDat DO
  215.     leftEdge:=50;
  216.     topEdge:=50;
  217.     width:=100;
  218.     height:=60;
  219.     detailPen:=0;
  220.     blockPen:=1;
  221.     idcmpFlags:=IDCMPFlagSet{closeWindow};
  222.     flags:=WindowFlagSet{windowDrag,windowClose,reportMouse,activate};
  223.     firstGadget:=NIL;
  224.     checkMark:=NIL;
  225.     title:=ADR("InEyes");
  226.     bitMap:=NIL;
  227.     minWidth:=50;
  228.     minHeight:=60;
  229.     maxWidth:=50;
  230.     maxHeight:=60;
  231.     type:=ScreenFlagSet{wbenchScreen};
  232.   END;
  233.   InWindow:=OpenWindow(InWinDat);
  234.   Assert(InWindow#NIL,ADR("Kann kein Window öffnen!"));
  235.   InRastPort:=InWindow^.rPort;
  236.   WBScreen:=InWindow^.wScreen;
  237.   Assert(WBScreen#NIL,ADR("Kriege keinen WBScreen!"));
  238.   VPort:=ADR(WBScreen^.viewPort);
  239. END OpWin;
  240.  
  241. PROCEDURE FuellData; (* $E- *)
  242. BEGIN
  243.   INLINE(0FFFFH);
  244.   INLINE(0FFFFH);
  245.   INLINE(0FFFFH);
  246.   INLINE(0FFFFH);
  247. END FuellData;
  248.  
  249. PROCEDURE DrawElls;
  250. VAR
  251.   Memory    : ADDRESS;
  252.   InTmpRas    : TmpRas;
  253.   InAreaInfo    : AreaInfo;
  254.   Buffer    : ARRAY[0..249] OF CARDINAL;
  255.   ok        : BOOLEAN;
  256. BEGIN
  257.   Memory:=AllocRaster(640,256);
  258.   InitArea(InAreaInfo,ADR(Buffer),100);
  259.   InitTmpRas(InTmpRas,Memory,RasSize(640,256));
  260.   InRastPort^.tmpRas:=ADR(InTmpRas);
  261.   InRastPort^.areaInfo:=ADR(InAreaInfo);
  262.   SetDrMd(InRastPort,jam1);
  263.   SetAPen(InRastPort,3);
  264.   SetAfPen(InRastPort,ADR(FuellData),2);
  265.   ok:=AreaEllipse(InRastPort, xml, yml, 20, 20);
  266.   ok:=AreaEllipse(InRastPort, xmr, ymr, 20, 20);
  267.   ok:=AreaEnd(InRastPort);
  268.   FreeRaster(Memory,640,256);
  269. END DrawElls;
  270.  
  271. PROCEDURE DrawEyes;
  272. BEGIN
  273.   Koo;
  274.   MoveSprite(VPort, ADR(InSprite1), xmlk, ymlk);
  275.   MoveSprite(VPort, ADR(InSprite2), xmrk, ymrk);
  276. END DrawEyes;
  277.  
  278.  
  279. BEGIN
  280.   IP:=SetTaskPri(FindTask(NIL), -50);
  281.  
  282.   TermProcedure(CleanUp);
  283.   OpWin;
  284.   SetDrMd(InRastPort, jam1);
  285.   DrawElls;
  286.  
  287.   InstallSprites;
  288.  
  289.   DrawEyes;
  290.  
  291.   LOOP
  292.  
  293.     WHILE NOT (InWindow^.userPort^.sigBit IN SetSignal(LONGSET{},LONGSET{}) ) DO
  294.       DrawEyes;
  295.     END;
  296.     WaitPort(InWindow^.userPort);
  297.     Message:=GetMsg(InWindow^.userPort);
  298.     class:=Message^.class;
  299.     ReplyMsg(Message);
  300.  
  301.     IF (closeWindow IN class) THEN EXIT; END;
  302.  
  303.   END;
  304. END InEyes.
  305.